home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / glibmm-2.4 / proc / pm / Function.pm < prev    next >
Encoding:
Perl POD Document  |  2006-04-20  |  7.7 KB  |  352 lines
  1. package Function;
  2.  
  3. use strict;
  4. use warnings;
  5. use Util;
  6. use FunctionBase;
  7.  
  8. BEGIN {
  9.      use Exporter   ();
  10.      our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  11.  
  12.      # set the version for version checking
  13.      $VERSION     = 1.00;
  14.      @ISA         = qw(FunctionBase);
  15.      @EXPORT      = qw(&func1 &func2 &func4);
  16.      %EXPORT_TAGS = ( );
  17.      # your exported package globals go here,
  18.      # as well as any optionally exported functions
  19.      @EXPORT_OK   = qw($Var1 %Hashit &func3);
  20.      }
  21. our @EXPORT_OK;
  22.  
  23. ##################################################
  24. ### Function
  25. # Commonly used algorithm for parsing a function declaration into
  26. # its component pieces
  27. #
  28. #  class Function : FunctionBase
  29. #    {
  30. #       string rettype;
  31. #       bool const;
  32. #       bool static;
  33. #       string name; e.g. gtk_accelerator_valid
  34. #       string c_name;
  35. #       string array param_type;
  36. #       string array param_name;
  37. #       string array param_default_value;
  38. #       string in_module; e.g. Gtk
  39. #       string signal_when. e.g. first, last, or both.
  40. #       string class e.g. GtkButton ( == of-object. Useful for signal because their names are not unique.
  41. #       string entity_type. e.g. method or signal
  42. #    }
  43.  
  44. sub new_empty()
  45. {
  46.   my $self = {};
  47.   bless $self;
  48.  
  49.   return $self;
  50. }
  51.  
  52. # $objFunction new($function_declaration, $objWrapParser)
  53. sub new($$)
  54. {
  55.   #Parse a function/method declaration.
  56.   #e.g. guint gtk_something_set_thing(guint a, const gchar* something)
  57.  
  58.   my ($line, $objWrapParser) = @_;
  59.  
  60.   my $self = {};
  61.   bless $self;
  62.  
  63.   #Initialize member data:
  64.   $$self{rettype} = "";
  65.   $$self{rettype_needs_ref} = 0; #Often the gtk function doesn't do an extra ref for the receiver.
  66.   $$self{const} = 0;
  67.   $$self{name} = "";
  68.   $$self{param_types} = [];
  69.   $$self{param_names} = [];
  70.   $$self{param_default_values} = [];
  71.   $$self{in_module} = "";
  72.   $$self{class} = "";
  73.   $$self{entity_type} = "method";
  74.  
  75.   $line =~ s/^\s+//;  # Remove leading whitespace.
  76.   $line =~ s/\s+/ /g; # Compress white space.
  77.  
  78.   if ($line =~ /^static\s+([^()]+)\s+(\S+)\s*\((.*)\)\s*$/)
  79.   {
  80.     $$self{rettype} = $1;
  81.     $$self{name} = $2;
  82.     $$self{c_name} = $2;
  83.     $self->parse_param($3);
  84.     $$self{static} = 1;
  85.   }
  86.   elsif ($line =~ /^([^()]+)\s+(\S+)\s*\((.*)\)\s*(const)*$/)
  87.   {
  88.     no warnings qw(uninitialized); # disable the uninitialize warning for $4
  89.     $$self{rettype} = $1;
  90.     $$self{name} = $2;
  91.     $$self{c_name} = $2;
  92.     $self->parse_param($3);
  93.     $$self{const} = ($4 eq "const");
  94.   }
  95.   else
  96.   {
  97.     $objWrapParser->error("fail to parse $line\n");
  98.   }
  99.  
  100.   return $self;
  101. }
  102.  
  103.  
  104. # $objFunction new_ctor($function_declaration, $objWrapParser)
  105. # Like new(), but the function_declaration doesn't need a return type.
  106. sub new_ctor($$)
  107. {
  108.   #Parse a function/method declaration.
  109.   #e.g. guint gtk_something_set_thing(guint a, const gchar* something)
  110.  
  111.   my ($line, $objWrapParser) = @_;
  112.  
  113.   my $self = {};
  114.   bless $self;
  115.  
  116.   #Initialize member data:
  117.   $$self{rettype} = "";
  118.   $$self{rettype_needs_ref} = 0;
  119.   $$self{const} = 0;
  120.   $$self{name} = "";
  121.   $$self{param_types} = [];
  122.   $$self{param_names} = [];
  123.   $$self{param_default_values} = [];
  124.   $$self{in_module} = "";
  125.   $$self{class} = "";
  126.   $$self{entity_type} = "method";
  127.  
  128.   $line =~ s/^\s+//;  # Remove leading whitespace.
  129.   $line =~ s/\s+/ /g; # Compress white space.
  130.  
  131.   if ($line =~ /^(\S+)\s*\((.*)\)\s*/)
  132.   {
  133.     $$self{name} = $1;
  134.     $$self{c_name} = $2;
  135.     $self->parse_param($2);
  136.   }
  137.   else
  138.   {
  139.     $objWrapParser->error("fail to parse $line\n");
  140.   }
  141.  
  142.   return $self;
  143. }
  144.  
  145. # $num num_args()
  146. sub num_args #($)
  147. {
  148.   my ($self) = @_;
  149.   my $param_types = $$self{param_types};
  150.   return $#$param_types+1;
  151. }
  152.  
  153. # parses C++ parameter lists.
  154. # forms a list of types, names, and initial values
  155. #  (we don't currently use values)
  156. sub parse_param($$)
  157. {
  158.   my ($self, $line) = @_;
  159.  
  160.  
  161.   my $type = "";
  162.   my $name = "";
  163.   my $value = "";
  164.   my $id = 0;
  165.   my $has_value = 0;
  166.  
  167.   my $param_types = $$self{param_types};
  168.   my $param_names = $$self{param_names};
  169.   my $param_default_values = $$self{param_default_values};
  170.  
  171.   # clean up space and handle empty case
  172.   $line = string_trim($line);
  173.   $line =~ s/\s+/ /g; # Compress whitespace.
  174.   return if ($line =~ /^$/);
  175.  
  176.   # parse through argument list
  177.   my @str = ();
  178.   my $par = 0;
  179.   foreach (split(/(const )|([,=&*()])|(<[^,]*>)|(\s+)/, $line)) #special characters OR <something> OR whitespace.
  180.   {
  181.     next if ( !defined($_) or $_ eq "" );
  182.       
  183.     if ( $_ eq "(" ) #Detect the opening bracket.
  184.     {
  185.        push(@str, $_);
  186.        $par++; #Increment the number of parameters.
  187.        next;
  188.     }
  189.     elsif ( $_ eq ")" )
  190.     {
  191.        push(@str, $_);
  192.        $par--; #Decrement the number of parameters.
  193.        next;
  194.     }
  195.     elsif ( $par || /^(const )|(<[^,]*>)|([*&])|(\s+)/ ) #TODO: What's happening here?
  196.     {
  197.       push(@str, $_); #This looks like part of the type, so we store it.
  198.       next;
  199.     }
  200.     elsif ( $_ eq "=" ) #Default value
  201.     {
  202.       $type = join("", @str); #The type is everything before the = character.
  203.       @str = (); #Wipe it so that it will only contain the default value, which comes next.
  204.       $has_value = 1;
  205.       next;
  206.     }
  207.     elsif ( $_ eq "," ) #The end of one parameter:
  208.     {
  209.       if ($has_value)
  210.       {
  211.         $value = join("", @str); # If there's a default value, then it's the part before the next ",".
  212.       }
  213.       else
  214.       {
  215.         $type = join("", @str);
  216.       }
  217.  
  218.       if ($name eq "")
  219.       {
  220.         $name = sprintf("p%s", $#$param_types + 2)
  221.       }
  222.  
  223.       $type = string_trim($type);
  224.  
  225.       push(@$param_types, $type);
  226.       push(@$param_names, $name);
  227.       push(@$param_default_values, $value);
  228.       
  229.       #Clear variables, ready for the next parameter.
  230.       @str = ();
  231.       $type= "";
  232.       $value = "";
  233.       $has_value = 0;
  234.       $name = "";
  235.  
  236.       $id = 0;
  237.  
  238.       next;
  239.     }
  240.  
  241.     if ($has_value)
  242.     {
  243.       push(@str, $_);
  244.       next;
  245.     }
  246.  
  247.     $id++;
  248.     $name = $_ if ($id == 2);
  249.     push(@str, $_) if ($id == 1);
  250.  
  251.     if ($id > 2)
  252.     {
  253.       print STDERR "Can't parse $line.\n";
  254.       print STDERR "  arg type so far: $type\n";
  255.       print STDERR "  arg name so far: $name\n";
  256.       print STDERR "  arg default value so far: $value\n";
  257.     }
  258.   }
  259.  
  260.   # handle last argument  (There's no , at the end.)
  261.   if ($has_value)
  262.   {
  263.     $value = join("", @str);
  264.   }
  265.   else
  266.   {
  267.     $type = join("", @str);
  268.   }
  269.  
  270.   if ($name eq "")
  271.   {
  272.     $name = sprintf("p%s", $#$param_types + 2)
  273.   }
  274.  
  275.   $type = string_trim($type);
  276.  
  277.   push(@$param_types, $type);
  278.   push(@$param_names, $name);
  279.   push(@$param_default_values, $value);
  280. }
  281.  
  282. # add_parameter_autoname($, $type, $name)
  283. # Adds e.g "sometype somename"
  284. sub add_parameter_autoname($$)
  285. {
  286.   my ($self, $type) = @_;
  287.  
  288.   add_parameter($self, $type, "");
  289. }
  290.  
  291. # add_parameter($, $type, $name)
  292. # Adds e.g GtkSomething* p1"
  293. sub add_parameter($$$)
  294. {
  295.   my ($self, $type, $name) = @_;
  296.   $type = string_unquote($type);
  297.   $type =~ s/-/ /g;
  298.  
  299.   my $param_names = $$self{param_names};
  300.  
  301.   if ($name eq "")
  302.   {
  303.     $name = sprintf("p%s", $#$param_names + 2);
  304.   }
  305.  
  306.   push(@$param_names, $name);
  307.  
  308.   my $param_types = $$self{param_types};
  309.  
  310.   push(@$param_types, $type);
  311.  
  312.   return $self;
  313. }
  314.  
  315. # $string get_refdoc_comment()
  316. # Generate a readable prototype for signals.
  317. sub get_refdoc_comment($)
  318. {
  319.   my ($self) = @_;
  320.  
  321.   my $str = "  /**\n";
  322.  
  323.   $str .= "   * \@par Prototype:\n";
  324.   $str .= "   * <tt>$$self{rettype} \%$$self{name}(";
  325.  
  326.   my $param_names = $$self{param_names};
  327.   my $param_types = $$self{param_types};
  328.   my $num_params  = scalar(@$param_types);
  329.  
  330.   # List the parameters:
  331.   for(my $i = 0; $i < $num_params; ++$i)
  332.   {
  333.     $str .= $$param_types[$i] . ' ' . $$param_names[$i];
  334.     $str .= ", " if($i < $num_params - 1);
  335.   }
  336.  
  337.   $str .= ")</tt>\n";
  338.   $str .= "   */";
  339.  
  340.   return $str;
  341. }
  342.  
  343. sub get_is_const($)
  344. {
  345.   my ($self) = @_;
  346.  
  347.   return $$self{const};
  348. }
  349.  
  350. 1; # indicate proper module load.
  351.  
  352.